Monster Media 1996 #14/Monster Media No. 14 (April 1996) (Monster Media, Inc.).ISO/prog_bas/netuser.zip/DATA/VB/NetUser/16-Bit/NetUser.bas

BASIC Source File | 1995-12-18 | 6KB | 163 lines

Option Explicit
'
'   This module will return the user name of the person who signed into
'   the system. This module should work with the following operating
'   systems: Windows 3.x, Windows for Workgroups, Windows 95 and
'   Windows NT.
'
'   This module is written for 16 bit languages. If you are using a 32-bit program
'   then you should use the proper version of this file.
'
'   If the user will be running on Windows 95 or Windows NT then this module
'   requires the CALL32.DLL file to function correctly. This DLL should be
'   included with your application and copied to the users SYSTEM directory
'   under windows.
'
''''
'
'   Declare variables needed
'
Dim glngReturnStatus As Long
Dim mintInitialized As Integer
Dim mlngGetUserName As Long

Const SUCCESS = 1&
Const FAILURE = 0&
Const WV_WIN3X = 0
Const WV_WINWFW = 1
Const WV_WINNT = 2
Const WV_WIN95 = 3
'
'   API Declaration
'
Declare Function KRN_GetVersion Lib "Kernel" Alias "GetVersion" () As Integer
Declare Function KRN_GetWinFlags Lib "Kernel" Alias "GetWinFlags" () As Integer
Declare Function USR_WNetGetCaps Lib "User" Alias "WNetGetCaps" (ByVal nIndex As Integer) As Integer
Declare Function WFW_MNetNetworkEnum Lib "WFWNET.DRV" Alias "MNetNetworkEnum" (nIndex As Integer) As Integer
Declare Function WFW_MNetSetNextTarget Lib "WFWNET.DRV" Alias "MNetSetNextTarget" (ByVal nIndex As Integer) As Integer
Declare Function USR_WNetGetUser Lib "User" Alias "WNetGetUser" (ByVal sUser As String, nBufferSize As Integer) As Integer
Declare Function Declare32& Lib "call32.dll" (ByVal func$, ByVal library$, ByVal args$)
Declare Function GetUserNameA Lib "call32.dll" Alias "call32" (ByVal strUser As String, lngUserBuffer As Long, ByVal lngID As Long) As Integer


Function NetworkUserID() As String
'   This routine will get the name of the user signed onto the network.
'   If no username is found it will return an UnknownUser string.
'
    Dim lngBufferSize As Long
    Dim strUser As String

    On Error GoTo NetworkUserID_EH

    NetworkUserID = "UnknownUser"

    lngBufferSize = 255
    strUser = Space$(lngBufferSize)
'
'   Declare some variable/constants needed for 16-bit
'
    Dim intHandle As Integer
    Dim intEnumerate As Integer
    Dim intVersion As Integer
'
'   Get the users current windows version
'
    intVersion = WindowsVersion()
    Select Case intVersion
    Case WV_WIN3X
        glngReturnStatus = USR_WNetGetUser(strUser, CInt(lngBufferSize))
        If (glngReturnStatus = 0) Then
            strUser = Left$(strUser, InStr(strUser, Chr(0)) - 1)
        End If
    Case WV_WINWFW
        intHandle = 0
        intEnumerate = 0
        intEnumerate = WFW_MNetNetworkEnum(intHandle)
'
'   Scan through the networks until we get a name
'
        While (intEnumerate = 0)
            glngReturnStatus = WFW_MNetSetNextTarget(intHandle)
            glngReturnStatus = USR_WNetGetUser(strUser, CInt(lngBufferSize))
            If (glngReturnStatus = 0) Then
                strUser = Left$(strUser, InStr(strUser, Chr(0)) - 1)
            End If
            intEnumerate = WFW_MNetNetworkEnum(intHandle)
        Wend
    Case WV_WINNT, WV_WIN95
'
'   Initialize and call the Win32 API function(s)
'
        mlngGetUserName = Declare32("GetUserNameA", "advapi32.dll", "pp")
        glngReturnStatus = GetUserNameA(strUser, lngBufferSize, mlngGetUserName)
        If glngReturnStatus <> SUCCESS Then
            MsgBox "Problem during UserName, problem code is " & Error
            strUser = "UnknownUser"
            Exit Function
        End If
        strUser = Left$(strUser, lngBufferSize - 1)
    End Select
    NetworkUserID = strUser
    Exit Function

NetworkUserID_EH:
    NetworkUserID = "UnknownUser"
    Exit Function
End Function

Private Function WindowsVersion() As Integer
'
'   This routine will determine the DOS/Windows version(s).
'   It will return the values back to the calling program.
'
    Dim strLowByte As String
    Dim strHighByte As String
    Dim sglWindowsVersion As Single
    Dim intNetwork As Integer

    Const WNNC_NET_MultiNet = &H8000
    Const WNNC_SUBNET_WinWorkgroups = 4
    Const WNNC_NET_TYPE = 2
    Const WF_WINNT = &H4000

    On Error GoTo WindowsVersion_EH

    glngReturnStatus = KRN_GetWinFlags()
    If glngReturnStatus And WF_WINNT Then
        WindowsVersion = WV_WINNT
    Else
'
'   Since Windows NT is not running, find the version of windows
'
        glngReturnStatus = KRN_GetVersion()
        glngReturnStatus = glngReturnStatus And &HFFFF&
        strLowByte = Trim$(CStr(glngReturnStatus And &HFF))
        strHighByte = Trim$(CStr((glngReturnStatus And &HFF00) / 256))
        sglWindowsVersion = CSng(strLowByte & "." & strHighByte)

        Select Case sglWindowsVersion
        Case Is < 3.95                 ' User is not under Windows 95
'
'   Check to see if the user is running WFW 3.11
'
            intNetwork = USR_WNetGetCaps(WNNC_NET_TYPE)
            If (intNetwork And WNNC_NET_MultiNet) Then
                If ((intNetwork And &HFFFF) And WNNC_SUBNET_WinWorkgroups) <> 0 Then
                    WindowsVersion = WV_WINWFW
                Else
                    WindowsVersion = WV_WIN3X
               End If
            Else
                WindowsVersion = WV_WIN3X
            End If
        Case Else
            WindowsVersion = WV_WIN95
        End Select
    End If
    Exit Function

WindowsVersion_EH:
    MsgBox "Problem in WindowsVersion, problem is " & Error
    Exit Function
End Function